home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / sortdemo.zip / SDSORT07.INC < prev    next >
Text File  |  1992-04-15  |  3KB  |  80 lines
  1. (*
  2. ╔═══════════════════════════════════════════════════════════════════════════╗
  3. ║ Turbo Pascal 6.0 Include File : SDSORT07.INC                              ║
  4. ╟───────────────────────────────────────────────────────────────────────────╢
  5. ║ Program : SORTDEMO.PAS                                                    ║
  6. ╟───────────────────────────────────────────────────────────────────────────╢
  7. ║ Version : 1.0                                                             ║
  8. ╟───────────────────────────────────────────────────────────────────────────╢
  9. ║ Copyright (c) 1992  by  Jon S. Russell                                    ║
  10. ╟───────────────────────────────────────────────────────────────────────────╢
  11. ║ Heap sort routines for SORTDEMO.PAS                                       ║
  12. ╚═══════════════════════════════════════════════════════════════════════════╝
  13.                                                                            *)
  14. procedure HeapSort (var Info : InfoType);
  15. var
  16.   Index : IndexType;
  17.  
  18.   (*───────────────────────────────────────────────────────────────────────*)
  19.  
  20.   procedure ReHeapDown (var Heap   : InfoType;
  21.                             Root   : IndexType;
  22.                             Bottom : IndexType);
  23.  
  24.     (* Restores the heap order property to the subtree starting  *)
  25.     (* at Root.  On invocation or ReHeapDown, the order property *)
  26.     (* is violated (if at all) only by root node.                *)
  27.  
  28.   var
  29.     MaxChild   : IndexType;  (* index of child with larger value *)
  30.     RightChild : IndexType;  (* index of the right child node    *)
  31.     LeftChild  : IndexType;  (* index of the left child node     *)
  32.  
  33.   begin  (* ReHeapDown *)
  34.     LeftChild := Root * 2;
  35.     RightChild := Root * 2 + 1;
  36.  
  37.     (* Check for Base Case 1: Heap[Root] is a leaf *)
  38.     if LeftChild <= Bottom then
  39.       begin  (* Heap[Root] is not a leaf *)
  40.         if LeftChild=Bottom
  41.           then  (* MaxChild := index of child with larger value *)
  42.             MaxChild := LeftChild
  43.           else  (* pick the greater of the two children *)
  44.             if (Heap.List[LeftChild].Key > Heap.List[RightChild].Key)
  45.               then MaxChild := LeftChild
  46.               else MaxChild := RightChild;
  47.  
  48.         (* Check for Base Case 2:  order property intact *)
  49.         if Heap.List[Root].Key < Heap.List[MaxChild].Key then
  50.           begin  (* General Case:  swap and reheap *)
  51.             Swap(Heap, Root, MaxChild);
  52.             ReHeapDown(Heap, MaxChild, Bottom);
  53.           end;
  54.       end;
  55.   end;   (* ReHeapDown *)
  56.  
  57.   (*───────────────────────────────────────────────────────────────────────*)
  58.  
  59. begin  (* HeapSort *)
  60.   (* Build the original heap from the unsorted elements. *)
  61.   for Index := (Info.Len div 2) downto 1 do
  62.     ReHeapDown(Info, Index, Info.Len);
  63.  
  64.   (* Sort the elements in the heap by swapping the root *)
  65.   (* (current largest) value with the last unsorted     *)
  66.   (* value, then reheaping remaining part of the list.  *)
  67.   (* Loop Invariant: List[1] .. List[Index] represents  *)
  68.   (* a heap AND List[Index+1] .. List[Len] are          *)
  69.   (* sorted in ascending order.                         *)
  70.   for Index := Info.Len downto 2 do
  71.     begin
  72.       Swap(Info, 1, Index);
  73.       ReHeapDown(Info, 1, Index-1);
  74.     end; (* for *)
  75.  
  76.   Info.Sorted := true;
  77. end;   (* HeapSort *)
  78.  
  79. (*─────────────────────────────────────────────────────────────────────────*)
  80.